perm filename LIS2.SAI[1,ALS] blob
sn#001068 filedate 1972-06-05 generic text, type T, neo UTF8
00010 BEGIN "LISTEN"
00020 DEFINE ⊂="COMMENT"; ⊂ 4/5/72;
00030 ⊂ This is the master program for the use of signature tables in
00040 speech recognition. It calls on a number of MAC routines for
00050 much of the actual work but this program sets up the tables
00060 as defined by an auxillary file which may be changed or replaced
00070 without any alteration to this program as written or to its
00080 subroutines;
00090
00100 LABEL LZZZZ;
00110 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00120
00130 REQUIRE "PREPAR[SYS,THO]" LOAD_MODULE;
00140 REQUIRE "SIG[1,ALS]" LOAD_MODULE;
00150 REQUIRE "DPYSUB.HDR[1,3]" SOURCE_FILE;
00160 FORTRAN REAL PROCEDURE SQRT(REAL X);
00170 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00180 FORTRAN REAL PROCEDURE COS(REAL X);
00190 FORTRAN REAL PROCEDURE SIN(REAL X);
00200 REQUIRE "FFT8X[1,ALS]" LOAD_MODULE;
00210 EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;REFERENCE REAL X,Y);
00220 DEFINE DPYSIZ="1000";
00230 INTEGER ARRAY DPYBUF[1:DPYSIZ]; INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00240
00250 EXTERNAL PROCEDURE PREPARE;
00260 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00270 EXTERNAL PROCEDURE TIMSET;
00280 EXTERNAL REAL PROCEDURE RUNTIM;
00290 EXTERNAL STRING PROCEDURE INCHWL;
00300 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00310
00320 DEFINE BPS="12";
00330 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",TABSIZ="7400",LISSIZ="1000",INSIZ="24";
00340 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00350 DEFINE LBYT="ILDB(LBPT)";
00360 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
00362 DEFINE TBLSIZ="250";
00364
00370 STRING FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
00380 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00390 INTERNAL INTEGER ARRAY TABLES[0:TABSIZ];
00400 INTERNAL INTEGER ARRAY PHLIST,HLIST[00:63];
00410 INTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00420 INTERNAL INTEGER ARRAY FLIST[0:35];
00430 INTEGER ARRAY LFILE[0:'177];
00440 INTERNAL REAL ARRAY A,B,C[0:256];
00450 REAL X,SX;
00460 REAL ARRAY WINDOW[0:256];
00470 INTEGER ARRAY D[0:992];
00480 INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00490 INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00500 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF;
00510 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
00520 INTEGER H,I,J,K,L;
00530 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
00540 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
00550 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
00560 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
00570 ILPB,ILPC, IHPB,IHPC ;
00580 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00582 INTERNAL INTEGER ARRAY TABLET[0:TBLSIZ],TBLIS[0:TBLSIZ%5];
00584 INTERNAL INTEGER TFLAG;
00585 INTERNAL INTEGER ZEROF,ZEROC;
00586
00590 LABEL START;
00600 LABEL LABELA,LABELB,ZZZZ;
00610 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
00620 INTEGER HCOUNT,HINDEX;
00630 ⊂ ****SET UP****;
00010 PROCEDURE ARRDIS(INTEGER ARRAY A; INTEGER N,XPOS,YPOS;STRING ID);
00020 BEGIN
00030 COMMENT DISPLAYS A HISTOGRAM OF THE FIRST N VALUES OF ARRAY A AT XPOS,YPOS;
00040 INTEGER I,J,SP;
00050 INTEGER LY,DY;
00060 INTEGER MAX;
00070 MAX←0;
00080 FOR I←0 STEP 1 UNTIL N DO
00090 IF ABS(A[I])>MAX THEN MAX←ABS(A[I]);
00100 MAX←MAX/256;
00110 SP←1024%N; COMMENT HORIZONTAL SPACING;
00120 AIVECT(XPOS,YPOS); RVECT(1023,0); RIVECT(-1023,0); RVECT(0,256);
00130 LY←A[0]/MAX+YPOS;
00140 AIVECT(XPOS,LY);
00150 FOR I←1 STEP 1 UNTIL N-1 DO
00160 BEGIN
00170 DY←A[I]/MAX+YPOS-LY;
00180 LY←LY+DY;
00190 RVECT(SP,DY);
00200 END;
00210 AIVECT(XPOS,YPOS);
00220 FOR I←1 STEP 1 UNTIL 10 DO
00230 BEGIN
00240 RVECT(0,-15); COMMENT INSERT HORIZONTAL SCALE;
00250 RIVECT(26,15);
00260 RVECT(0,-5);
00270 RIVECT(26,5);
00280 RVECT(0,-10);
00290 RIVECT(26,10);
00300 RVECT(0,-5);
00310 RIVECT(26,5);
00320 END;
00330 RVECT(0,-15);
00340 AIVECT(XPOS,YPOS-40);
00350 DPYSST("0 1 2 3 4 5 6 7 8 9 10");
00360 AIVECT(XPOS,YPOS-60);
00370 DPYSST(ID);
00380 END "ARRDIS";
00390
00400 PROCEDURE DATDIS(INTEGER ARRAY A; INTEGER N,XPOS,YPOS;STRING ID);
00410 BEGIN
00420 COMMENT DISPLAYS A HISTOGRAM OF THE FIRST N VALUES OF ARRAY A AT XPOS,YPOS;
00430 INTEGER I,J,SP;
00440 INTEGER LY,DY;
00450 SP←1024%N; COMMENT HORIZONTAL SPACING;
00460 AIVECT(XPOS,YPOS); RVECT(1023,0);
00470 LY←A[0]/18+YPOS;
00480 AIVECT(XPOS,LY);
00490 FOR I←1 STEP 1 UNTIL N-1 DO
00500 BEGIN
00510 DY←A[I]/18+YPOS-LY;
00520 LY←LY+DY;
00530 RVECT(SP,DY);
00540 END;
00550 AIVECT(XPOS,YPOS-60); DPYSST(ID);
00560 END "DATDIS";
00570
00580 PROCEDURE RARDIS(REAL ARRAY C; INTEGER N,XPOS,YPOS;STRING ID);
00590 BEGIN
00600 COMMENT DISPLAYS A HISTOGRAM OF THE FIRST N VALUES OF ARRAY A AT XPOS,YPOS;
00610 INTEGER I,J,SP;
00620 INTEGER LY,DY;
00630 REAL MAX;
00640 MAX←0;
00650 FOR I←0 STEP 1 UNTIL N DO
00660 IF ABS(C[I])>MAX THEN MAX←ABS(C[I]);
00670 MAX←MAX/256;
00680 SP←1024%N; COMMENT HORIZONTAL SPACING;
00690 AIVECT(XPOS,YPOS); RVECT(1023,0); RIVECT(-1023,0); RVECT(0,256);
00700 LY←C[0]/MAX+YPOS;
00710 AIVECT(XPOS,LY);
00720 FOR I←1 STEP 1 UNTIL N-1 DO
00730 BEGIN
00740 DY←C[I]/MAX+YPOS-LY;
00750 LY←LY+DY;
00760 RVECT(SP,DY);
00770 END;
00780 AIVECT(XPOS,YPOS);
00790 FOR I←1 STEP 1 UNTIL 10 DO
00800 BEGIN
00810 RVECT(0,-15); COMMENT INSERT HORIZONTAL SCALE;
00820 RIVECT(26,15);
00830 RVECT(0,-5);
00840 RIVECT(26,5);
00850 RVECT(0,-10);
00860 RIVECT(26,10);
00870 RVECT(0,-5);
00872 RIVECT(26,5);
00874 END;
00900 RVECT(0,-15);
00910 AIVECT(XPOS,YPOS-40);
00920 DPYSST("0 1 2 3 4 5 6 7 8 9 10");
00930 AIVECT(XPOS,YPOS-60);
00940 DPYSST(ID);
00950 END "RARDIS";
00960
00970 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
00980 BEGIN
00990 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
01000 COMPLEX TRANSFORM ;
01010 INTEGER K,NK,NH;
01020 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
01030 NH←N%2; R←3.1415926536/N;
01040 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
01050 DC←-0.5*R; CK←1.0; SK←0;
01060 IF EVALUATE THEN
01070 BEGIN
01080 CK←-1.0; DC←-DC;
01090 END
01100 ELSE
01110 BEGIN
01120 A[N]←A[0]; B[N]←B[0];
01130 END;
01140 FOR K←0 STEP 1 UNTIL NH DO
01150 BEGIN
01160 NK←N-K;
01170 AA←A[K]+A[NK]; AB←A[K]-A[NK];
01180 BA←B[K]+B[NK]; BB←B[K]-B[NK];
01190 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
01200 B[NK]←IM-BB; B[K]←IM+BB;
01210 A[NK]←AA-RE; A[K]←AA+RE;
01220 DC←R*CK+DC; CK←CK+DC;
01230 DS←R*SK+DS; SK←SK+DS;
01240 END;
01250 END "XRTRAN";
00010 COMMENT MACROS;
00020 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00030 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00040 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00050 DEFINE TIL="STEP 1 UNTIL";
00060 DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
00070 INTEGER K.,J.; ⊂ USED IN MACROS;
00080 DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
00090 DEFINE ISQRT(I)="(K.←(I)↑0.5)";
00100 DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
00110 DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
00120 DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
00130 DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
00140 DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
00150 DEFINE FTRACE(N)=
00160 "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
00170 OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
00180 DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
00190 DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
00200 DEFINE PI="3.141592653",PICON="(PI/180)";
00210 DEFINE INFINITY="'377777777777";
00220 STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
00230
00240 INTERNAL PROCEDURE SETBR;
00250 BEGIN
00260 SETBREAK(1,CR,LF,"IN");
00270 SETBREAK(2,CR&",",LF&TB&" ","IN");
00280 SETBREAK(3,NULL,NULL,"IN");
00290 SETBREAK(4,CR&TB&" ",LF&",","IN");
00300 SETBREAK(5,CR,LF,"ISP"); ⊂ SKIP CR&LF, KEEP LINE NBR AND TAB;
00310 SETBREAK(6,CR&TB&" ",LF&".,","IN");
00320 SETBREAK(7,NULL,0,"I"); ⊂ TO REMOVE NULL CHARACTERS FROM STRING;
00330 SETBREAK(8, "=←;[("&CR , LF&" ])" , "IN");
00340 SETBREAK(9,NULL,0&" "&CR&LF&TB,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE
00350 NUMBERS, NULLS, BLANKS, CR`S, LF`S, TB`S;
00360 SETBREAK(10," "&TB&CR,"0123456789"&LF,"IN");
00370 SETBREAK(11,NULL,0,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE NUMBERS,
00380 AND NULLS;
00390 END "SETBR";
00400
00410
00420 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00430 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00440 BOOLEAN NF;
00450 LOOKUP(CHAN,FILENAME,NF);
00460 WHILE NF DO
00470 BEGIN
00480 OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
00490 FILENAME ← INPUT(TTY,1);
00500 LOOKUP(CHAN,FILENAME,NF)
00510 END;
00520 END "LOOKIN";
00530
00540
00550 PROCEDURE TELL;
00560 BEGIN
00570 INTEGER TELPPT,TELQPT;
00580 ⊂ To report on the performance of the signature tables;
00590 INTEGER I,J,K,L,HPOINT,MX,IX;
00600
00610 OUTSTR(CRLF&"HINT: "&CVXSTR(PHLIST[H])&TB);
00620
00630 HPOINT←POINT(1,HLIST[H],-1);
00640 FOR I←0 STEP 1 UNTIL 35 DO
00650 IF (K←ILDB(HPOINT))=1 THEN OUTSTR(CVXSTR(FLIST[I])&" ");
00660 OUTSTR(CRLF&"INPUT:"); SETFORMAT(3,0);
00670 FOR I←0 STEP 1 UNTIL 18 DO OUTSTR(CVS(INDAT[I]));
00675 OUTSTR(" "&CVS(ZEROC));
00680 OUTSTR(CRLF&LF&"Table"&TB&"Type"&TB&"Learn"&TB&"Output"&CRLF);
00690 SETFORMAT(1,0);
00700 L←INTOT;
00710 FOR I←INTOT*74 STEP 74 UNTIL TABSIZ DO BEGIN
00720 IF TABLES[I+1]=0 THEN DONE ELSE BEGIN "DECODE" STRING LEARN; INTEGER K1,K2,K3,K4;
00730 IF LIST[L+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
00740 K←LIST[L+LISSIZ%5]; K1←K LSH -18; K2←(K LSH 18) LSH -30;
00750 K3←(K LSH 24) LSH -30; K4←(K LSH 30) LSH -30;
00760 LEARN←CVXSTR(PHLIST[K1])[1 TO 2]&CVXSTR(PHLIST[K2])[1 TO 2]&
00770 CVXSTR(PHLIST[K3])[1 TO 2]&CVXSTR(PHLIST[K4])[1 TO 2];
00780 END
00790 ELSE LEARN←CVXSTR(LIST[L+LISSIZ%5]);
00800 OUTSTR(CVXSTR(LIST[L])&TB&CVXSTR(LIST[L+LISSIZ%10])&LEARN&TB);
00810 END "DECODE";
00820 OUTSTR(CVS(LDB(POINT(3,TABLES[I],2))));
00830 IF LDB(POINT(1,TABLES[I+1],5))≠0 THEN BEGIN
00840 OUTSTR(TB&CVS(LDB(POINT(3,TABLES[I],5)))&TB&CVS(LDB(POINT(3,TABLES[I],8)))
00850 &TB&CVS(LDB(POINT(3,TABLES[I],11))));
00860 OUTSTR(TB&CVS(LDB(POINT(3,TABLES[I],14)))); L←L+1;I←I+74 END;
00870 OUTSTR(CRLF);
00872 L←L+1;
00874 END;
00876 IF TFLAG≠0 THEN BEGIN L←0;
00878 OUTSTR(CRLF&"Name"&TB&"Input"&TB&"Level"&TB&"Hyst"&TB&"Prob"&TB&"St.Seg"&TB&
00880 "SegCnt"&CRLF); FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
00882 IF TABLET[I+1]=0 THEN DONE ELSE IF TABLET[I+2]≤0 THEN BEGIN "COUNT"
00884 OUTSTR(CVXSTR(TABLET[I+1])&TB&CVXSTR(TBLIS[L])&TB&
00886 CVS(LDB(POINT(3,TABLET[I+2],3)))&TB&
00888 CVS(LDB(POINT(2,TABLET[I+2],5)))&TB&
00890 CVS(LDB(POINT(3,TABLET[I],3)))&TB&
00892 CVS(LDB(POINT(8,TABLET[I],10)))&TB&
00894 CVS(LDB(POINT(7,TABLET[I],17)))&CRLF);
00896 END "COUNT"; L←L+1; END; END;
00898
00900
00910 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00920 LOOKUP(CHAN6,"TELL.DOC",0);
00930 DEFINE UGETF="'073000000000";
00940 START_CODE;
00950 UGETF 6,I;
00960 END;
00970 ENTER(CHAN6,"TELL.DOC",0);
00980 USETO(CHAN6,I);
00990
01000 SETFORMAT(2,0); OUT(CHAN6,CVS(SEGC)&" "); SETFORMAT(4,0);
01010 FOR I←0 STEP 2 UNTIL 18 DO OUT(CHAN6,CVS(INDAT[I]));
01020 SETFORMAT(2,0); OUT(CHAN6," ");
01030 FOR I←INTOT STEP 1 UNTIL LISSIZ-1 DO BEGIN
01040 IF LIST[I]=0 THEN DONE;
01050 J←I*74;
01060 TELPPT←POINT(3,TABLES[J],2);
01070 ⊂ TELQPT←POINT(3,TABLES[J],17);
01080 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
01081 MX←0; IX←0;
01082 FOR K←1 STEP 1 UNTIL 4 DO BEGIN
01083 L←LDB(POINT(3,TABLES[J],K*3+2));
01084 IF L>MX THEN BEGIN MX←L; IX←K END; END;
01085 IF MX=0 THEN IX←0;
01086
01090 OUT(CHAN6,CVS(IX));
01100 I←I+1;
01110 END ELSE
01120 OUT(CHAN6,CVS(LDB(TELPPT)));
01130 END;
01140 OUT(CHAN6,CRLF&" "&CVXSTR(PHLIST[H])[1 TO 3]); SETFORMAT(4,0);
01150 FOR I←1 STEP 2 UNTIL 18 DO OUT(CHAN6,CVS(INDAT[I]));
01160 OUT(CHAN6,CRLF);
01162 IF TFLAG≠0 THEN BEGIN L←0; TFLAG←0;
01163 OUT(CHAN6,CRLF&"Name"&TB&"Input"&TB&"Level"&TB&"Hyst"&TB&"Prob"&TB&"St.Seg"&TB&
01164 "SegCnt"&CRLF); FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
01165 IF TABLET[I+1]=0 THEN DONE ELSE IF TABLET[I+2]≤0 THEN BEGIN "COUNT"
01166 OUT(CHAN6,CVXSTR(TABLET[I+1])&TB&CVXSTR(TBLIS[L])&TB&
01167 CVS(LDB(POINT(3,TABLET[I+2],3)))&TB&
01168 CVS(LDB(POINT(2,TABLET[I+2],5)))&TB&
01169 CVS(LDB(POINT(3,TABLET[I],3)))&TB&
01170 CVS(LDB(POINT(8,TABLET[I],10)))&TB&
01171 CVS(LDB(POINT(7,TABLET[I],17)))&CRLF);
01172 J←LDB(POINT(35,TABLET[I+2],35)); TABLET[I+2]←0;
01173 TABLET[I+2]←J; END "COUNT"; L←L+1; END; END;
01180 CLOSE(CHAN6);
01190 END "TELL";
01200
01210 STRING PROCEDURE HEADER;
01220 BEGIN STRING H1,H2; INTEGER I,J,K;
01230 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
01240 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
01250 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
01260
01270 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
01280 IF J ≥ 0 THEN BEGIN "LATCH"
01290 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
01300 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
01310 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
01320 HCOUNT←HCOUNT-J;
01330 HINDEX←HINDEX+1; RETURN(PREHINT); DONE
01340 END
01350 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
01360 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
01370 END;
01380 END "LATCH";
01390 PREHINT←""; RETURN(PREHINT); END "XX";
01400 END "HEADER";
01410
00010 SETBR;
00020 UPCNT←3;
00030 FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00040 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00050 CLOSE(CHAN1);
00060 OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00070 LOOKUP(CHAN1,"TABLES.DAT",0);
00080 ARRYIN(CHAN1,INSUB[0],INSIZ);
00090 ARRYIN(CHAN1,INDIV[0],INSIZ);
00100 ARRYIN(CHAN1,INCNT[0],INSIZ);
00110 ARRYIN(CHAN1,INNAM[0],INSIZ);
00120 ARRYIN(CHAN1,FLIST[0],36);
00130 ARRYIN(CHAN1,PHLIST[0],64);
00140 ARRYIN(CHAN1,HLIST[0],64);
00150 ARRYIN(CHAN1,TABLES[0],TABSIZ);
00155 ARRYIN(CHAN1,TABLET[0],TBLSIZ);
00160
00165 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO BEGIN
00167 J←((TABLET[I+2] LSH -30) LSH 30); TABLET[I+2]←J; END;
00170 CLOSE(CHAN5); CLOSE(CHAN6);
00180 OPEN(CHAN5,"DSK",'10,10,0,0,0,EOF);
00190 LOOKUP(CHAN5,"SIGLST.DAT",0);
00200 ARRYIN(CHAN5,LIST[0],LISSIZ);
00210 INTOT←WORDIN(CHAN5);
00212 ARRYIN(CHAN5,TBLIS[0],TBLSIZ%5);
00220 RELEASE(CHAN5);
00230 IF STRIN("Should old TELL.DOC be spooled YorN = ")="Y" THEN BEGIN
00240 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00250 LOOKUP(CHAN6,"TELL.DOC",0);
00260 RENAME(CHAN6,"TELL.OLD",0,EOF);
00270 CLOSE(CHAN6);
00280 SPOOL("TELL.OLD",GETCHAN,1);
00290 END;
00300 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00310 ENTER(CHAN6,"TELL.DOC",0);
00320 OUT(CHAN6,TB&"Session iniated "&DATIME&CRLF); CLOSE(CHAN6);
00330 START:
00560 IF (TFILEI←STRIN("DATA FILE("&FILEI&") = "))≠"" THEN FILEI←TFILEI;
00575 M←8;
00590 N←2↑M; NF←2*N;
00600 FOR I←0 STEP 1 UNTIL N DO
00610 WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00620
00630 N←2↑M;
00640 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF);
00650 LOOKUP(CHAN6,"TELL.DOC",0);
00660 DEFINE UGETF="'073000000000";
00670 START_CODE;
00680 UGETF 6,I;
00690 END;
00700 ENTER(CHAN6,"TELL.DOC",0);
00710 USETO(CHAN6,I);
00720 OUT(CHAN6,CRLF&DATIME&" Data file "&FILEI&" WITH "&CVS(SEGTOT)&" SEGMENTS."&CRLF&LF&"SEG. ");
00730 FOR I←0 STEP 2 UNTIL 18 DO OUT(CHAN6,CVXSTR(INNAM[I])[1 TO 4]);
00740 FOR I←INTOT STEP 2 UNTIL LISSIZ-1 DO BEGIN
00750 IF LIST[I]=0 THEN DONE;
00760 OUT(CHAN6,CVXSTR(LIST[I])[1 TO 3]&" ");
00770 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00780 IF LIST[I+1+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00790 END;
00800 OUT(CHAN6,CRLF&" HINT ");
00810 FOR I←1 STEP 2 UNTIL 17 DO OUT(CHAN6,CVXSTR(INNAM[I])[1 TO 4]);
00820 OUT(CHAN6," ");
00830 FOR I←INTOT+1 STEP 2 UNTIL LISSIZ-1 DO BEGIN
00840 IF LIST[I]=0 THEN DONE;
00850 OUT(CHAN6,CVXSTR(LIST[I])[1 TO 3]&" ");
00860 IF LIST[I+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00870 IF LIST[I+1+LISSIZ%10]≥CVSIX("Q0") THEN I←I+1;
00880 END;
00890 OUT(CHAN6,CRLF&LF);
00900 CLOSE(CHAN6);
00910 OUTSTR(CRLF&"Should HINTS be obtained from HEADER ? (Y or CR)= ");
00920 HINDEX←21; HCOUNT←0; OPT1←"Y"; OPT2←"Y"; STEPX←INCHWL;
00930 IF STEPX="Y" THEN BEGIN
00940 STPMOD←STRIN(CRLF&"Step one HINT at a time ? (YorCR)= ");
00950 IF STPMOD≠"Y" THEN BEGIN OPT2←"N";
00952
00955 OPT1←STRIN(CRLF&"Want slow mode with TELL (YorCR)= ");
00960 OUTSTR("Single character commands while in HEADER mode"&CRLF&TB&
00965 "S to enter slow mode with TELL"&CRLF&TB&
00967 "F to enter fast mode without TELL"&CRLF&TB&
00968 "P to show pointer"&CRLF&TB&
00970 "/ to leave HEADER mode for current segment only and display FFT"&
00980 CRLF&TB&"Y to go to STEPMODE"&
00990 CRLF&TB&"N to leave HEADER mode permanently"&CRLF); END; END;
01000 OUTSTR(CRLF&"Shift DATABUF by WORDS = ");
01010 DATSHIFT←CVD(INCHWL); ⊂ USE TO TEST PHASE SENSITIVITY OF LEARNING;
01020
01030 LABELA: CLOSE(CHAN4);
01040 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
01050 LOOKIN(CHAN4,FILEI);
01060 EOF←0; SEGC←0; SEGCNT←0;
01070 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
01080 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2]; OUTSTR(CRLF&"SAM RATE ="&CVS(LFILE[2]));
01090 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
01100 ⊂ **** SET PARAMETER RANGES
01110 THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
01120 NP=800/1500 NZRNG=NP+/-500 ?
01130 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
01140 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
01150 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
01160 I3L←1950./SX; I3H←3250./SX+.5;
01170 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
01180 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
01190 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
01200 BPTFST←POINT(BPS,DATBUF[0],-1);
01201 IF DATSHIFT>0 THEN
01210 ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
01220 ARRYIN(CHAN4,DATBUF[0],BUFEXS);
01230 SEGMRK←SEGC←K←1;
01240 WHILE EOF=0 DO
01250 BEGIN
01260 IF SEGC>SEGTOT THEN DONE;
01270 ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
01280
01290 IF EOF≠0 THEN
01300 BEGIN
01310 J←EOF LAND '777777;
01320 FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0;
01330 END;
01340 IF SEGMRK<SEGC+30 THEN BEGIN "FOUND"
01350 K←1;
01360 LBPT←POINT(BPS,DATBUF[0],-1);
01370
01380 FOR I←0 STEP 1 UNTIL 992 DO
01390 BEGIN D[I]←LBYTE; J←ILDB(LBPT); J←ILDB(LBPT); J←ILDB(LBPT); END;
01400 SETFORMAT(2,1);
01410 DPYSET(DPYBUF); TYPLOC(200,-450);
01420 DATDIS(D,992,-511,400," ");
01430 AIVECT(-511,250);
01440 DPYSST(DATIME&" Data file "&FILEI&" "&CVS(SEGTOT)&" half segments"
01450 &" M="&CVS(M)&" "&CVS(RATE%1000)&" kH.");
01452 DPPOINT←DPYPARS; DPP1←DPYBUF[1]; DPP2←DPYBUF[2];
01455 IF OPT2≠"Y" THEN BEGIN "LINNUM" INTEGER K1;
01456 SETFORMAT(1,0); FOR K1←1 STEP 1 UNTIL 6*DATSIZ%N DO
01457 BEGIN J←((K1-1)*160*N)%DATSIZ-511;
01458 AIVECT(J,284);DPYSST(CVS(SEGC+K1-1)); END;
01459 DPYOUT(1); END "LINNUM";
01470
01480 BPT←BPTFST; SEGSAV←SEGC;
01490 LZZZZ: WHILE K≤6*DATSIZ%N DO BEGIN
01500 IF (J←SEGMRK-SEGC)>0 THEN BEGIN
01510 FOR I←1 STEP 1 UNTIL J DO BEGIN
01520 BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
01530 K←K+J; SEGC←SEGMRK; END;
01540 IF SEGC>SEGTOT THEN DONE;
01550 IF K>6*DATSIZ%N THEN DONE;
01560
01570 BPTSAV←BPT;
01575 IF OPT2="Y" THEN BEGIN
01580 J←((K-1)*160*N)%DATSIZ-511;
01590 AIVECT(J,400); RVECT(0,-130);
01600 RIVECT(14,14); SETFORMAT(1,0); DPYSST(CVS(SEGC));
01610 AIVECT(J,270); J←320*N%DATSIZ; RVECT(J,0);RVECT(0,130);
01620 DPYOUT(1); END;
01625
01630 I←0; WHILE I≥0 DO BEGIN
01640 IF STEPX="Y" THEN BEGIN READ1←HEADER; OUTSTR(CRLF&CRLF&"HINT ("&CVS(SEGC)&") = "&READ1);
01650
01660 IF (READ2←INCHRS)="/" THEN BEGIN READ1←READ2; DONE END;
01670 IF READ2="Y" THEN BEGIN STPMOD←"Y"; OPT2←"Y"; END;
01680 IF READ2="N" THEN BEGIN STPMOD←"Y"; STEPX←"N"; END;
01685 IF READ2="S" THEN OPT1←"Y"; IF READ2="F" THEN OPT1←"";
01687 IF READ2="P" THEN OPT2←"Y";
01690
01700 IF STPMOD="Y" THEN BEGIN OUTSTR("OK? "); IF (READ2←INCHWL)≠"" THEN READ1←READ2 END; END
01710 ELSE READ1←STRIN(CRLF&CRLF&"HINT = ");
01720 IF READ1="" THEN BEGIN SEGMRK←SEGC+1; DONE END;
01730
01740
01750 IF READ1="/" THEN DONE;
01760 IF (READ2←READ1[1 TO 1]) ≤"9" THEN BEGIN
01770 LABELB: SEGMRK←SEGC+CVD(READ1);
01780 IF SEGMRK<SEGSAV THEN GO TO LABELA;
01790 IF SEGMRK≤SEGC THEN BEGIN BPTSAV←BPTFST; K←1;SEGC←SEGSAV; END;
01800 READ1←"";
01810 DONE END ELSE BEGIN "TRUHNT"
01820 J←CVSIX(READ1);
01830 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
01840 IF PHLIST[I]=0 THEN BEGIN OUTSTR("Hint not found.Try again"&CRLF);I←64;DONE END;
01850 IF PHLIST[I]=J THEN BEGIN
01855 HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
01860 END;
01880 IF I<64 THEN BEGIN SEGMRK←SEGC+1; DONE END;
01890 END "TRUHNT"; END;
01900 IF READ1≠"" THEN BEGIN
01910 J←I←ZEROC←0; A[J]←BYTE*WINDOW[I]; B[J]←BYTE*WINDOW[I+1]; J←J+1;
01915 IF B[J]<A[J] THEN ZEROF←0 ELSE ZEROF←1;
01920 FOR I←2 STEP 2 UNTIL N-1 DO
01930 BEGIN
01940 A[J]←BYTE*WINDOW[I];
01945 IF A[J]<B[J-1] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01950 B[J]←BYTE*WINDOW[I+1];
01951 IF B[J]<A[J] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01960 J←J+1;
01970 END;
01980 FRXFM(M-1,A[0],B[0]);
01990 XRTRAN(A,B,N/2,FALSE);
02000 FOR I←0 STEP 1 UNTIL N/2 DO C[I]←5.*ALOG10(A[I]↑2+B[I]↑2);
02010 END; ⊂ End of first IF READ1="" ;
02020 IF READ1="/" THEN BEGIN OPT2←"Y";
02030 RARDIS(C,N/2,-511,0,"POWER VS FREQUENCY"); TYPLOC(-100,-450);
02033 J←((K-1)*160*N)%DATSIZ-511;
02034 AIVECT(J,400); RVECT(0,-130);
02035 RIVECT(14,14); SETFORMAT(1,0); DPYSST(CVS(SEGC));
02036 AIVECT(J,270); J←320*N%DATSIZ; RVECT(J,0);RVECT(0,130);
02037 DPYOUT(1);
02038 DPYRESET(DPPOINT); DPYBUF[1]←DPP1; DPYBUF[2]←DPP2; DPYPTR←DPP1;
02040 I←0; WHILE I≥0 DO BEGIN
02050 READ1←STRIN(CRLF&CRLF&"HINT= ");
02060 IF READ1="" THEN DONE;
02070
02080
02090 J←CVSIX(READ1);
02100 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
02110 IF PHLIST[I]=0 THEN BEGIN OUTSTR("Hint not found.Try again"&CRLF);I←64;DONE END;
02120 IF PHLIST[I]=J THEN BEGIN HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
02130 END;
02140 IF I<64 THEN DONE;
02150 END;
02160 TYPLOC(200,-450); END;
02170 IF READ1≠"" THEN BEGIN
02180 PREPARE;
02190
02200 ZZZZ: SIG(P);
02205 IF OPT1="Y" THEN
02210 TELL;
02220 IF FLAG≠0 THEN BEGIN
02230 FLAG←0;
02240 CLOSE(CHAN2);
02250 OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
02260 ENTER(CHAN2,"TABLES.SAV",0);
02270 ARRYOUT(CHAN2,INSUB[0],INSIZ);
02280 ARRYOUT(CHAN2,INDIV[0],INSIZ);
02290 ARRYOUT(CHAN2,INCNT[0],INSIZ);
02300 ARRYOUT(CHAN2,INNAM[0],INSIZ);
02310 ARRYOUT(CHAN2,FLIST[0],36);
02320 ARRYOUT(CHAN2,PHLIST[0],64);
02330 ARRYOUT(CHAN2,HLIST[0],64);
02340 ARRYOUT(CHAN2,TABLES[0],TABSIZ);
02345 ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
02350 CLOSE(CHAN2);
02360 OUTSTR("Tables have been saved as TABLES.SAV"&CRLF);
02370 END;
02380 END; ⊂ END of second IF READ1≠"" ;
02390 DPYRESET(DPPOINT); DPYBUF[1]←DPP1; DPYBUF[2]←DPP2; DPYPTR←DPP1;
02400 IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE;
02410 END; ⊂ End of WHILE K≤ ;
02420 END "FOUND";
02430 SEGC←SEGSAV+6*DATSIZ%N; K←1;
02440 FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
02450 FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0;
02460 END;
02470 CLOSE(CHAN1);
02480 OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
02490 ENTER(CHAN2,"TABLES.DAT",0);
02500 ARRYOUT(CHAN2,INSUB[0],INSIZ);
02510 ARRYOUT(CHAN2,INDIV[0],INSIZ);
02520 ARRYOUT(CHAN2,INCNT[0],INSIZ);
02530 ARRYOUT(CHAN2,INNAM[0],INSIZ);
02540 ARRYOUT(CHAN2,FLIST[0],36);
02550 ARRYOUT(CHAN2,PHLIST[0],64);
02560 ARRYOUT(CHAN2,HLIST[0],64);
02570 ARRYOUT(CHAN2,TABLES[0],TABSIZ);
02575 ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
02580 CLOSE(CHAN2);
02590 OUTSTR("Tables have been saved as TABLES.DAT"&CRLF);
02600 GO TO START;
00010 END "LISTEN";